(FILECREATED "15-APR-74 06:45:03" EXPAND)


  (LISPXPRINT (QUOTE EXPANDVARS)
	      T)
  (RPAQQ EXPANDVARS
	 ((FNS TURNON TURNOFF START RESTART FIXFN UNFIXFN REFIXFN GENAPPLY 
	       GENEXPANSION ISFORM MAKELIST GETVAL MAKEMAKEFORM NOFORMIN 
	       STRUCINCL STRUCINLIST STATE STRUCLIST? GETFILENAM EXPANDER 
	       EXPAND DOEXPAND WRITERESULTS MAPFNS)
	  (VARS (FIXEDFNLIST))
	  (USERMACROS UPFORM EXPAND !EXPAND ISFORM NEXTFORM NEXFORM GROUP 
		      FORMNOFORM Q # ARGS D FN W DO WW COMMANDS U FF #1 #2 #3 
		      #4 #5 #6 #7 #8 #9)
	  (PROP VALTYPE ATTACHFVS ATTACHBIVALENTS ATTACHBIVS&LOOPS 
		STRUCTURESWITHATOMS PERMRADS)
	  (PROP (EXPANDFLAG STRUCCHECK CONDITIONS VALTYPE)
		* EACHSTEP)))
(DEFINEQ

(TURNON
(LAMBDA (FN) (* Turns off the function FN; fixes it first if it hasn't been
already, otherwise, just resets its flag to T. FN may be a list of functions,
or NIL for all functions that have been fixed) (MAPFNS FN (FUNCTION (LAMBDA
(FN) (COND ((NOT (GETP FN (QUOTE FIXED))) (FIXFN FN))) (/SET (GETP FN (QUOTE
EXPANDFLAG)) NIL))) FIXEDFNLIST)))

(TURNOFF
(LAMBDA (FN) (* Similar to TURNON, except it turns OFF the function) (MAPFNS
FN (FUNCTION (LAMBDA (FN) (COND ((NOT (GETP FN (QUOTE FIXED))) (FIXFN FN)))
(/SET (GETP FN (QUOTE EXPANDFLAG)) T))) FIXEDFNLIST)))

(START
(LAMBDA (FUNCTIONNAME) (* Starts the user in the interactive (editor based)
EXPAND package, looking at a FORM for the function functionname (or "MOLECULES"
if no functionname is given) after prompting for the values of the various
arguments - Saves the FORM on the variable "SAVEDRESULTS" so that even after
accidental control-d, it is recoverable (see the function RESTART)) (OR 
FUNCTIONNAME (SETQQ FUNCTIONNAME MOLECULES)) (TURNOFF FUNCTIONNAME) (EDITL
(LIST (SETQ SAVEDRESULTS (create FORM FN ← FUNCTIONNAME ARGS ← (for X in (
ARGLIST FUNCTIONNAME) collect (RP X)))) (SETQ SAVEDRESULTS (LIST SAVEDRESULTS)))
NIL (QUOTE SAVEDRESULTS) (PACK (LIST FUNCTIONNAME ":"))) (QUOTE SAVEDRESULTS)))

(RESTART
(LAMBDA NIL (* Attempts to get user back to place in the STRUCFORM tree where
he was before (i.e. "START)" , do some things, exit with "OK" , and then 
"RESTART)" and you are back where you were before the "OK" %. Does an "@"
so that you know where you are when you RESTART (it isn't ALWAYS successful
in finding the last place pointed to))) (EDITL (LIST SAVEDRESULTS) (QUOTE
(≠START 1 (ORR (\) NIL) @)) (QUOTE SAVEDRESULTS) (QUOTE restart:)) (QUOTE
SAVEDRESULTS)))

(FIXFN
(LAMBDA (FN VALTYPE STRUCCHECK CONDITIONS NOADVICEFLG) (* DECLARATIONS:) (*
"FIX" the function FN; VALTYPE is either "LSTRUC" meaning that the function
returns a list OF structures, or "STRUC" meaning that it returns a single
STRUCTURE - STRUCCHECK is either NIL, or a digit N, meaning that the function
takes a STRUCTURE as its nth argument (and should CHECK for it being a "STRUCFORM")
- CONDITIONS is a list OF lisp forms which, if ANY evaluate to non-nil, the
function must be "TURNED OFF" ; an EXAMPLE is the function GENMOL, which takes
not a STRUCTURE but a composition list which might contain a 
structure/strucform; in this case CONDITIONS is the list ((STRUCINCL CL))
where STRUCINCL is a function which checks if there is a STRUCFORM in a 
composition list. If ANY argument is NIL, FIXFN first checks the property
list OF FN, and otherwise prompts the user) (MAPFNS FN (FUNCTION (LAMBDA (FN)
(VIRGINFN (SETQ FN (FNCHECK FN NIL T)) T) (* FNCHECK DOES SPELLING CORRECTION
IF FN IS NOT A FUNCTION; VIRGINFN UNADVISES AND UNBREAKS THE FUNCTION IF IT
IS ALREADY ADVISED AND/OR BROKEN (SEE LISP MANUAL)) (/REMPROP FN (QUOTE FIXED))
(PROG ((VALTYPE (GETVAL FN VALTYPE)) (FNFLAG (OR (GETP FN (QUOTE EXPANDFLAG))
(/PUT FN (QUOTE EXPANDFLAG) (PACK (LIST FN (GENSYM)))))) CHECKVAR CONDITION
(WT (ITIMES 2 DWIMWAIT)) FIXED) (* Fnflag is the flag for this function; usually
found on the property list) (/SET FNFLAG T) (SETQ FIXED (LIST FNFLAG)) (COND
((NUMBERP (SETQ CHECKVAR (OR STRUCCHECK (GETP FN (QUOTE STRUCCHECK)) (/PUT
FN (QUOTE STRUCCHECK) (APPLY* (QUOTE Y/N) (CONS (QUOTE (N . o)) (for Z in
(ARGLIST FN) as I from 1 collect (CONS I (CONCAT " " Z)))) (LIST FN 
"check for STRUCFORM in" (ARGLIST FN))))))) (SETQ FIXED (CONS (LIST (QUOTE
TYPE?) (QUOTE STRUCFORM) (CAR (NTH (ARGLIST FN) CHECKVAR))) FIXED)))) (SETQ
CONDITIONS (OR CONDITIONS (GETP FN (QUOTE CONDITIONS)) (/PUT FN (QUOTE 
CONDITIONS) (bind CONDITION while CONDITION← (Y/N NIL "add extra condition?")
collect CONDITION)))) (SETQ FIXED (APPEND (REMOVE NIL CONDITIONS) FIXED))
(SETQ FIXED (LIST (QUOTE AND) (COND ((CDR FIXED) (CONS (QUOTE OR) FIXED))
(T (CAR FIXED))) (LIST (QUOTE RETURN) (SELECTQ VALTYPE (LSTRUC (LIST (QUOTE
LIST) (MAKEMAKEFORM FN))) (MAKEMAKEFORM FN))))) (COND ((NULL NOADVICEFLG)
(/PUT FN (QUOTE FIXED) T) (ADVISE FN (QUOTE BEFORE) FIXED) (/RPLACA (QUOTE
FIXEDFNLIST) (CONS FN FIXEDFNLIST))))))) FIXEDFNLIST)))

(UNFIXFN
(LAMBDA (FN) (* UNDOES A FIXFN) (MAPFNS FN (FUNCTION (LAMBDA (FN) (VIRGINFN
FN T) (/REMPROP FN (QUOTE FIXED)) (/RPLACA (QUOTE FIXEDFNLIST) (REMOVE FN
FIXEDFNLIST)))) FIXEDFNLIST)))

(REFIXFN
(LAMBDA (FN) (* SAME AS FIXFN, EXCEPT THAT IT IGNORES THE PROPERTY LIST OF
FN) (MAPFNS FN (FUNCTION (LAMBDA (FN) (/REMPROP FN (QUOTE VALTYPE)) (/RPLACA
(QUOTE FIXEDFNLIST) (REMOVE FN FIXEDFNLIST)) (/REMPROP FN (QUOTE CONDITIONS))
(/REMPROP FN (QUOTE STRUCCHECK)) (FIXFN FN))) FIXEDFNLIST)))

(GENAPPLY
(LAMBDA (FORM GOLIST MUSTCHANGEFLG) (* FORM is a "STRUCFORM" ; this does the
APPLY of the fnname to the argument list; the golist is a list of functions
that should be "TURNED ON" during the evaluation; if mustchangeflg is T, and
the value after the APPLY is the same as the value before, causes an error;
this ALWAYS returns a single thing; if FN returns a list ofstructures (by
the "LSTRUC" property) , then they are embedded in a "(STRUCFORM LIST ---)")
(PROG (EVALFORM (NEWFORM FORM)) (* Kludgey way of rebinding all of the 
EXPANDFLAGs to NIL by embedding in a PROG and then EVALing that PROG - EXPANDER
uses NEWFORM as a free variable and just does (APPLY (CAR NEWFORM) (CDR NEWFORM)))
(SETQ EVALFORM (LIST (QUOTE PROG) (for V in (CONS (CADR NEWFORM) GOLIST) join
(AND (SETQ V (GETP V (QUOTE EXPANDFLAG))) (LIST V))) (QUOTE (EXPANDER))))
(SETQ NEWFORM (MAKELIST (EVAL EVALFORM))) (AND MUSTCHANGEFLG (EQUAL NEWFORM
FORM) (PRIN1 "nothing done.
" T) (ERROR!)) (RETURN NEWFORM))))

(GENEXPANSION
(LAMBDA NIL (OR (STRUCLIST? (##)) (HELP "BAD ARG TO GENEXPANSION")) (* This
function assumes it is called from the editor and uses the edit pushdown list
freely. However, it assumes that the editor is looking at a strucform - the
idea is to expand the thing into the next higher STRUCFORM) (PROG ((FORM (##))
(0FORM (## !0)) (UPFORML (EDITL0 L (QUOTE (UPFORM))))) (/RPLNODE2 (CAR UPFORML)
(COND ((NUMBERP (CDR 0FORM)) (* This corresponds to a composition list which
contains a STRUCLIST - to expand it, need to substitute the GROUPRADS of the
expansion: (((STRUCLIST A B C) . 3) ...) goes to ((A . 3) ...) ((A . 2) (B
. 2) ...) ((A . 1) (B . 1) (C . 1) ...) etc.) (MAKELIST (for L in (GROUPRADS
(LIST (CONS (fetch LISTITEMS of FORM) (CDR 0FORM)))) collect (LSUBST (CLCREATE
L) 0FORM (CAR UPFORML))))) ((STRUCLIST? (CAR UPFORML)) (LSUBST (fetch LISTITEMS
of FORM) FORM (CAR UPFORML))) (T (MAKELIST (for L in (fetch LISTITEMS of FORM)
collect (SUBST L FORM (CAR UPFORML))))))) (SETQ L UPFORML))))

(ISFORM
(LAMBDA (AT) (type? STRUCFORM AT)))

(MAKELIST
(LAMBDA (MAKELISTVAR) ((LAMBDA (L) (COND ((CDR L) (create STRUCLIST LISTITEMS
← L)) (T (CAR L)))) (MAPCONC MAKELISTVAR (FUNCTION (LAMBDA (Y) (COND ((
STRUCLIST? Y) (APPEND (FETCH LISTITEMS OF Y))) (T (LIST Y)))))))))

(GETVAL
(LAMBDA (FN VALTYPE) (OR (AND (NOT VALTYPE) (GETP FN (QUOTE VALTYPE))) (/PUT
FN (QUOTE VALTYPE) (SELECTQ (OR VALTYPE (PROGN (PRIN1 FN T) (Y/N ((L . ist)
(S . ingle)) " value type (list/single)?"))) (L (QUOTE LSTRUC)) (QUOTE STRUC)))))
)

(MAKEMAKEFORM
(LAMBDA (FN) (CONS (QUOTE LIST) (CONS (QUOTE (QUOTE STRUCFORM)) (CONS (KWOTE
FN) (ARGLIST FN))))))

(NOFORMIN
(LAMBDA (X) (OR (NLISTP X) (AND (NOT (type? STRUCFORM X)) (EVERY X (FUNCTION
NOFORMIN))))))

(STRUCINCL
(LAMBDA (CL) (SOME CL (FUNCTION (LAMBDA (X) (type? STRUCFORM (CAR X)))))))

(STRUCINLIST
(LAMBDA (LIST) (SOME LIST (FUNCTION (LAMBDA (ITEM) (type? STRUCFORM ITEM))))))

(STATE
(LAMBDA (FN) (COND ((NULL FN) (SETQ FN FIXEDFNLIST))) (COND ((LISTP FN) (MAPC
FN (FUNCTION (LAMBDA (X) (MAPRINT (STATE X) T NIL ".
" NIL NIL T))))) (T (CONS FN (CONS (QUOTE is) (COND ((SETQ FN (GETP FN (QUOTE
EXPANDFLAG))) (SELECTQ (EVALV FN) (T (QUOTE (off))) (NIL (QUOTE (on))) (QUOTE
(in some wierd state)))) (T (QUOTE (not fixed))))))))))

(STRUCLIST?
(LAMBDA (X) (AND (type? STRUCFORM X) (EQ (FETCH LISTID OF X) (QUOTE LIST)))))

(GETFILENAM
(LAMBDA (IO) (PROG NIL LP (OR (SELECTQ IO ((I INPUT) (INFILEP (PROGN (PRIN1
"input file? " T) (READ T)))) (OUTFILEP (PROGN (PRIN1 "output file? " T) (READ
T)))) (PROGN (PRIN1 "can't access" T) (TERPRI T) (GO LP))))))

(EXPANDER
(LAMBDA NIL (COND ((EQ MUSTCHANGEFLG (QUOTE DO)) (* (DO NIL UP MARK 1 (LCL
!!EXPAND) ←← 1 (IF (AND (NOT (STRUCLIST? (##)) (type? STRUCFORM (##)))) (!EXPAND)
(NIL)) @)) (* EXPAND ALL FORMS INTERIOR TO AN EXPRESSION) (OR (DOEXPAND NEWFORM)
(LIST NEWFORM))) (T (SELECTQ (GETVAL (CADR NEWFORM)) (STRUC (LIST (APPLY (CADR
NEWFORM) (CDDR NEWFORM)))) (LSTRUC (APPLY (CADR NEWFORM) (CDDR NEWFORM)))
(HELP))))))

(EXPAND
(LAMBDA (!EXPANDFLG) (PROG ((TEM (##)) TEM2) (COND ((AND (NEQ !EXPANDFLG (QUOTE
DO)) (STRUCLIST? TEM)) (GENEXPANSION)) ((type? STRUCFORM TEM) (SETQ TEM2 (
GENAPPLY TEM (AND !EXPANDFLG FIXEDFNLIST) (OR !EXPANDFLG T))) (COND ((LISTP
TEM2) (/RPLNODE2 TEM TEM2)) (T (/RPLACA (## UP) TEM2) (SETQ L (CONS TEM2 (CDR
L)))))) (T (ERROR!))))))

(DOEXPAND
(LAMBDA (FORM) (* ASSUMES EVERYTHING TURNED ON) (* RETURNS A LIST OF POSSIBLE
EXPANSIONS FOR FORM, OR NIL; WILL RETURN NIL IF EITHER NO FORM CONTAINED WITHIN,
OR THERE IS ONLY ONE "EXPANSION" OF FORM; (IN WHICH CASE IT HAS /RPLNODED
IT IN; ERRORS IF THERE ARE ZERO EXPANSIONS - (PROBABLY SHOULDN'T , BUT I'M
NOT SURE WHAT IT SOULD DO))) (COND ((type? STRUCTURE FORM) NIL) ((NLISTP FORM)
NIL) ((EVERY FORM (FUNCTION (LAMBDA (X) (NUMBERP (CDR X))))) (PROG (TEM1 TEM2
TEM3) (for X in FORM do (COND ((SETQ TEM3 (DOEXPAND (CAR X))) (SETQ TEM1 (CONS
(CONS TEM3 (CDR X)) TEM1))) (T (SETQ TEM2 (CONS X TEM2))))) (COND (TEM1 (for
Z in (GROUPRADS TEM1) collect (NCONC (CLCREATE Z) TEM2)))))) ((STRUCLIST?
FORM) (MAPCONC (CDDR FORM) (FUNCTION (LAMBDA (X) (OR (DOEXPAND X) (LIST X))))))
((type? STRUCFORM FORM) (PROG ((TEM (DOEXPAND (CDDR FORM)))) (SETQ TEM (COND
((NULL TEM) (SELECTQ (GETVAL (CADR FORM)) (LSTRUC (APPLY (CADR FORM) (CDDR
FORM))) (STRUC (LIST (APPLY (CADR FORM) (CDDR FORM)))) (HELP))) (T (SELECTQ
(GETVAL (CADR FORM)) (LSTRUC (for X in TEM join (APPLY (CADR FORM) X))) (STRUC
(for X in TEM collect (APPLY (CADR FORM) X))) (HELP))))) (COND ((NULL TEM)
NIL) ((OR (NLISTP (CAR TEM)) (CDR TEM)) TEM) (T (/RPLNODE2 FORM (CAR TEM))
NIL)))) (T (PROG ((TEM (DOEXPAND (CAR FORM))) (TEM2 (DOEXPAND (CDR FORM))))
(OR TEM TEM2 (RETURN)) (COND ((NULL TEM) (for X in TEM2 collect (CONS (CAR
FORM) X))) ((NULL TEM2) (for X in TEM collect (CONS X (CDR FORM)))) (T (for
X in TEM join (for Y in TEM2 collect (CONS TEM TEM2))))))))))

(WRITERESULTS
(LAMBDA (EXPRESSION) (OR (AND (type? STRUCFORM EXPRESSION) (CAR (NLSETQ (PROG
(FIL RSLT) (SETQ FIL (GETFILENAM (QUOTE OUTPUT))) (OUTPUT (OUTFILE FIL)) (PRINT
EXPRESSION FIL) (SETQ RSLT (CLOSEF FIL)) (/RPLNODE2 EXPRESSION (LIST (QUOTE
STRUCFORM) (QUOTE READFILE) FIL)) (RETURN RSLT))))) (QUOTE can't))))

(MAPFNS
(LAMBDA (MAPFNX MAPFNAPPLYFN DEFAULT) (COND ((NULL MAPFNX) (SETQ MAPFNX DEFAULT)))
(COND ((LISTP MAPFNX) (MAPCAR MAPFNX (FUNCTION (LAMBDA (ZZZ) (AND (SETQ ZZZ
(FNCHECK ZZZ NIL T)) (APPLY* MAPFNAPPLYFN ZZZ)) ZZZ)))) (T (SETQ MAPFNX (FNCHECK
MAPFNX NIL T)) (APPLY* MAPFNAPPLYFN MAPFNX) MAPFNX))))
)
  (RPAQ FIXEDFNLIST)
  (ADDTOVAR USERMACROS (#9 NIL (# 9))
	    (#8 NIL (# 8))
	    (#7 NIL (# 7))
	    (#6 NIL (# 6))
	    (#5 NIL (# 5))
	    (#4 NIL (# 4))
	    (#3 NIL (# 3))
	    (#2 NIL (# 2))
	    (#1 NIL (# 1))
	    [!EXPAND NIL (ORR ((E (EXPAND T)
				  T))
			      ((E (QUOTE can't]
	    [# (X)
	       (IF (NUMBERP (QUOTE X))
		   [(IF (STRUCLIST? (##))
			((COMS (IPLUS X 2)))
			((E (HELP))
			 (LCL (I F (QUOTE ((*ANY* STRUCTURE STRUCFORM)
					   --))
				 (ADD1 X]
		   (E (QUOTE ?]
	    (D NIL (LCL NEXTFORM))
	    (DO NIL [ORR ((E (EXPAND (QUOTE DO))
			     T))
			 ((E (QUOTE can't]
		@)
	    (EXPAND X MARK (LC . X)
		    EXPAND ←←)
	    [EXPAND NIL (ORR ((E (EXPAND)
				 T))
			     ((E (QUOTE can't]
	    (FF NIL FORMNOFORM)
	    (FN (X)
		F
		(STRUCFORM X --))
	    [FORMNOFORM NIL (LC STRUCFORM (IF (NOFORMIN (CDR (##]
	    [GROUP (X Y)
		   (IF (STRUCLIST? (##))
		       ((COMS (SUBPAIR (QUOTE (Z W))
				       (LIST (IPLUS X 2)
					     (IPLUS Y 2))
				       (QUOTE (EMBED (Z THRU W)
						     IN STRUCFORM LIST]
	    [ISFORM NIL (IF (STRUCFORM (##]
	    (NEXFORM NIL (ORR (ISFORM)
			      (NEXTFORM)))
	    (NEXTFORM NIL (ORR (F (STRUCFORM --))
			       (UPFORM)))
	    (U NIL UPFORM)
	    (UPFORM NIL 0 (← STRUCFORM))
	    [W NIL (E (WRITERESULTS (##]
	    (WW NIL MARK (LPQ UPFORM)
		(IF (STRUCLIST? (##))
		    (W)
		    ((MBD STRUCFORM LIST)
		     W))
		←←)
	    [COMMANDS NIL (E (MAPCAR USERMACROS (FUNCTION CAR]
	    (Q NIL (MBD QUOTE)))
  (ADDTOVAR EDITCOMSA Q COMMANDS WW W UPFORM U NEXTFORM NEXFORM ISFORM 
	    FORMNOFORM FF EXPAND DO D !EXPAND #1 #2 #3 #4 #5 #6 #7 #8 #9)
  (ADDTOVAR EDITCOMSL GROUP FN EXPAND #)
(DEFLIST(QUOTE(
  (ATTACHFVS LSTRUC)
  (ATTACHBIVALENTS LSTRUC)
  (ATTACHBIVS&LOOPS LSTRUC)
  (STRUCTURESWITHATOMS LSTRUC)
  (PERMRADS LSTRUC)
))(QUOTE VALTYPE))

  (RPAQQ EACHSTEP (MOLECULES RINGS RINGSKELETONS NOFVRINGS DAISIES 
			     NOLOOPEDRINGS CATALOG SINGLERINGS GENMOL))
(DEFLIST(QUOTE(
  (MOLECULES MOLECULESA0012)
  (RINGS RINGSA0014)
  (RINGSKELETONS RINGSKELETONSA0016)
  (NOFVRINGS NOFVRINGSA0018)
  (DAISIES DAISIESA0020)
  (NOLOOPEDRINGS NOLOOPEDRINGSA0022)
  (CATALOG CATALOGA0024)
  (SINGLERINGS SINGLERINGSA0026)
  (GENMOL GENMOLA0028)
))(QUOTE EXPANDFLAG))

(DEFLIST(QUOTE(
  (MOLECULES N)
  (RINGS N)
  (RINGSKELETONS N)
  (NOFVRINGS N)
  (DAISIES N)
  (NOLOOPEDRINGS N)
  (CATALOG N)
  (SINGLERINGS N)
  (GENMOL N)
))(QUOTE STRUCCHECK))

(DEFLIST(QUOTE(
  (MOLECULES (NIL))
  (RINGS (NIL))
  (RINGSKELETONS (NIL))
  (NOFVRINGS (NIL))
  (DAISIES (NIL))
  (NOLOOPEDRINGS (NIL))
  (CATALOG (NIL))
  (SINGLERINGS (NIL))
  (GENMOL (NIL))
))(QUOTE CONDITIONS))

(DEFLIST(QUOTE(
  (MOLECULES LSTRUC)
  (RINGS LSTRUC)
  (RINGSKELETONS LSTRUC)
  (NOFVRINGS LSTRUC)
  (DAISIES LSTRUC)
  (NOLOOPEDRINGS LSTRUC)
  (CATALOG LSTRUC)
  (SINGLERINGS LSTRUC)
  (GENMOL LSTRUC)
))(QUOTE VALTYPE))

STOP